home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d1 / doscolor.arc / DOSCSETC.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-07-13  |  8.5 KB  |  217 lines
  1. 10  RUN "DOSCSTRT"
  2. 20  REM Initialize program
  3. 30  GOSUB 500
  4. 40  REM Display initial screen
  5. 50  GOSUB 1000
  6. 60  ON J GOTO 70,90,110,130
  7. 70  REM Select border color
  8. 80  GOSUB 2000:GOTO 40
  9. 90  REM Select background color
  10. 100  GOSUB 3000:GOTO 40
  11. 110  REM Select foreground color
  12. 120  GOSUB 4000:GOTO 40
  13. 130  REM Rewrite DOSCOLOR.COM
  14. 140  GOSUB 5000
  15. 150  REM Close all files and return to DOS
  16. 160  CLOSE:COLOR 7,0,0:CLS
  17. 170  SYSTEM
  18. 500  REM Initializion routine
  19. 510  DEFINT A-Z:DIM SGR$(7):SGR$(0)="0":SGR$(1)="4":SGR$(2)="2":SGR$(3)="6":SGR$(4)="1":SGR$(5)="5":SGR$(6)="3":SGR$(7)="7":SGRSTR$=CHR$(&H1B)+"[0;37;40m$"
  20. 520  DEF FNCENT(A$)=(SWID-LEN(A$))/2
  21. 530  KEY OFF:FOR I=1 TO 10:KEY I,"":NEXT I
  22. 540  ON ERROR GOTO 23000
  23. 550  DEF SEG=&H40:STYP=(PEEK(&H10) AND &H30)\&H10:DEF SEG:IF STYP>1 THEN SWID=80:T1=28:T2=18:BLINE$=" ":IND$="":NL=0 ELSE SWID=40:T1=5:T2=2:BLINE$=CHR$(13):IND$=CHR$(186)+"  ":NL=1
  24. 560  D$=""
  25. 570  OPEN "I",#1,D$+"DOSCOLOR.COM"
  26. 580  CLOSE #1
  27. 590  OPEN "R",#1,D$+"DOSCOLOR.COM",1
  28. 600  ON ERROR GOTO 20000
  29. 610  FIELD #1,1 AS A$
  30. 620  GET #1,&HB:BORDER=ASC(A$)
  31. 630  GET #1,&HC:BG=ASC(A$)
  32. 640  GET #1,&HD:FG=ASC(A$)
  33. 650  GET #1,&HE:FGHI=ASC(A$)
  34. 660  GET #1,&HF:I=ASC(A$):FGINVCB=INT(I/16):FGINVCF=I-16*FGINVCB:IF FGINVCF=0 THEN REVVID=1:FGINV=FGINVCB ELSE REVVID=0:FGINV=FGINVCF
  35. 670  IF REVVID=1 THEN IF FGINV>8 THEN FGINV=FGINV-8
  36. 680  CLOSE #1
  37. 690  BORDER=0:BG=0:FG=7:FGHI=15:FGINV=7:REVVID=1:FGINVCF=FGINV:FGINVCB=BG
  38. 700  WIDTH SWID:SCREEN 0,1:COLOR FG,BG,BORDER:CLS
  39. 710  SUB$=SPACE$(100):FOR I=1 TO 100:READ J:MID$(SUB$,I,1)=CHR$(J):NEXT I:SUB2$=SPACE$(17):FOR I=1 TO 17:READ J:MID$(SUB2$,I,1)=CHR$(J):NEXT I
  40. 720  GOSUB 10000 ' Clear screen and draw border
  41. 730  PAGFROM=0:PAGTO=1:GOSUB 21000 ' Save border for later
  42. 740  DATA &H55,&H89,&HE5,&H8B,&H76,&H08,&H8B,&H14,&HB1,&H04,&HD3,&HE2,&H8B,&H76,&H06,&H8B,&H04,&H09,&HC2,&H8B,&H76,&H0A,&H8B,&H04,&HB3,&H10,&HF6,&HEB,&HB1,&H08,&HD3,&HE0,&H89,&HC7,&H8B,&H76,&H0C,&H8B,&H04,&HF6,&HEB,&HB1,&H08,&HD3,&HE0
  43. 750  DATA &H89,&HC6,&H1E,&H06,&H52,&HBA,&HDA,&H03,&HEC,&HA8,&H08,&H74,&HFB,&HB0,&H25,&HBA,&HD8,&H03,&HEE,&H5A,&HB8,&H00,&HB8,&H8E,&HD8,&H8E,&HC0,&HB9,&H00,&H10,&HFC,&HAD,&H88,&HD4,&HAB,&HE2,&HFA
  44. 760  DATA &HB8,&H40,&H00,&H8E,&HD8,&HA0,&H65,&H00,&HBA,&HD8,&H03,&HEE,&H07,&H1F,&H5D,&HCA,&H08,&H00,&H55,&H89,&HE5,&H8B,&H5E,&H06,&H8B,&H57,&H01,&HB4,&H09,&HCD,&H21,&H5D,&HCA,&H02,&H00
  45. 770  RETURN
  46. 1000  REM Display initial screen routine
  47. 1010  CLS:PAGFROM=1:PAGTO=0:GOSUB 21000 ' Clear screen and draw border
  48. 1020  GOSUB 13000 ' Display function key definitions
  49. 1030  GOSUB 14000 ' Display title
  50. 1040  GOSUB 9000 ' Display menu
  51. 1050  GOSUB 11000:IF I<>2 THEN IF J<49 OR J>52 THEN GOSUB 15000:GOTO 1050 ELSE PRINT CHR$(J);:J=J-48:FOR K=1 TO 50:NEXT K:RETURN
  52. 1060  IF J<59 OR J>62 THEN GOSUB 15000:GOTO 1050
  53. 1070  J=J-58
  54. 1080  RETURN
  55. 2000  REM Select border color
  56. 2010  CLS:PAGFROM=1:PAGTO=0:GOSUB 21000 ' Clear screen and draw border
  57. 2020  GOSUB 14000 ' Display title
  58. 2030  GOSUB 16000 ' Display text
  59. 2040  GOSUB 11000:IF I<>2 THEN IF J<49 OR J>51 THEN GOSUB 15000:GOTO 2040 ELSE PRINT CHR$(J);:J=J-48:FOR K=1 TO 50:NEXT K:GOTO 2060
  60. 2050  GOSUB 15000:GOTO 2040
  61. 2060  ON J GOTO 2070,2080,2090
  62. 2070  BORDER=BORDER+1:IF BORDER>15 THEN BORDER=BORDER-16:GOTO 2100 ELSE GOTO 2100
  63. 2080  BORDER=BORDER-1:IF BORDER<0 THEN BORDER=BORDER+16:GOTO 2100 ELSE GOTO 2100
  64. 2090  RETURN
  65. 2100  COLOR ,,BORDER:LOCATE ,POS(0)-1:PRINT " ";:LOCATE ,POS(0)-1:GOTO 2040
  66. 3000  REM Select background color
  67. 3010  CLS:PAGFROM=1:PAGTO=0:GOSUB 21000 ' Clear screen and draw border
  68. 3020  GOSUB 14000 ' Display title
  69. 3030  GOSUB 17000 ' Display text
  70. 3040  GOSUB 11000:IF I<>2 THEN IF J<49 OR J>51 THEN GOSUB 15000:GOTO 3040 ELSE PRINT CHR$(J);:J=J-48:FOR K=1 TO 50:NEXT K:GOTO 3060
  71. 3050  GOSUB 15000:GOTO 3040
  72. 3060  ON J GOTO 3070,3080,3090
  73. 3070  BG=BG+1:IF BG>7 THEN BG=BG-8:GOTO 3100 ELSE GOTO 3100
  74. 3080  BG=BG-1:IF BG<0 THEN BG=BG+8:GOTO 3100 ELSE GOTO 3100
  75. 3090  RETURN
  76. 3100  IF BG=FG THEN 3060 ELSE COLOR ,BG:LOCATE ,POS(0)-1:PRINT " ";:LOCATE ,POS(0)-1:GOTO 3010
  77. 4000  REM Select foreground color
  78. 4010  CLS:PAGFROM=1:PAGTO=0:GOSUB 21000 ' Clear screen and draw border
  79. 4020  GOSUB 14000 ' Display title
  80. 4030  GOSUB 18000 ' Display text
  81. 4040  GOSUB 11000:IF I<>2 THEN IF J<49 OR J>56 THEN GOSUB 15000:GOTO 4040 ELSE PRINT CHR$(J);:J=J-48:FOR K=1 TO 50:NEXT K:GOTO 4060
  82. 4050  GOSUB 15000:GOTO 4040
  83. 4060  ON J GOTO 4070,4080,4090,4110,4130,4140,4170,4200
  84. 4070  FG=FG+1:IF FG>15 THEN FG=FG-16:GOTO 4210 ELSE GOTO 4210
  85. 4080  FG=FG-1:IF FG<0 THEN FG=FG+16:GOTO 4210 ELSE GOTO 4210
  86. 4090  FGHI=FGHI+1:IF FGHI>15 THEN FGHI=FGHI-16
  87. 4100  IF FGHI=BG THEN 4090 ELSE GOTO 4210
  88. 4110  FGHI=FGHI-1:IF FGHI<0 THEN FGHI=FGHI+16
  89. 4120  IF FGHI=BG THEN 4110 ELSE GOTO 4210
  90. 4130  REVVID=(REVVID XOR 1):IF FGINV>8 THEN FGINV=FGINV-8:GOTO 4210 ELSE GOTO 4210
  91. 4140  IF REVVID=1 THEN LIM=7 ELSE LIM=15
  92. 4150  FGINV=FGINV+1:IF FGINV>LIM THEN FGINV=FGINV-LIM-1
  93. 4160  IF FGINV=BG THEN 4150 ELSE 4210
  94. 4170  IF REVVID=1 THEN LIM=7 ELSE LIM=15
  95. 4180  FGINV=FGINV-1:IF FGINV<0 THEN FGINV=FGINV+LIM+1
  96. 4190  IF FGINV=BG THEN 4180 ELSE 4210
  97. 4200  RETURN
  98. 4210  IF FG=BG THEN 4060 ELSE COLOR FG:LOCATE ,POS(0)-1:PRINT " ";:LOCATE ,POS(0)-1:GOTO 4010
  99. 5000  REM Rewrite DOSCOLOR.COM
  100. 5010  ON ERROR GOTO 22000
  101. 5020  D$=""
  102. 5030  OPEN "I",#1,D$+"DOSCOLOR.COM"
  103. 5040  CLOSE #1
  104. 5050  OPEN "R",#1,D$+"DOSCOLOR.COM",1
  105. 5060  ON ERROR GOTO 0
  106. 5070  FIELD #1,1 AS A$
  107. 5080  LSET A$=CHR$(BORDER):PUT #1,&HB
  108. 5090  LSET A$=CHR$(BG):PUT #1,&HC
  109. 5100  LSET A$=CHR$(FG):PUT #1,&HD
  110. 5110  LSET A$=CHR$(FGHI):PUT #1,&HE
  111. 5120  IF REVVID=1 THEN LSET A$=CHR$(FGINV*16) ELSE LSET A$=CHR$(FGINV)
  112. 5130  PUT #1,&HF
  113. 5140  IF FG>7 THEN MID$(SGRSTR$,3,1)="1":LSET A$="1" ELSE MID$(SGRSTR$,3,1)="0":LSET A$="0"
  114. 5150  PUT #1,&H13
  115. 5160  IF FG>7 THEN FGC=FG-8 ELSE FGC=FG
  116. 5170  MID$(SGRSTR$,6,1)=SGR$(FGC):LSET A$=SGR$(FGC):PUT #1,&H16
  117. 5180  MID$(SGRSTR$,9,1)=SGR$(BG):LSET A$=SGR$(BG):PUT #1,&H19
  118. 5190  CLOSE #1
  119. 5200  DEF SEG=0:ZS!=PEEK(&H43)*256+PEEK(&H42):ZO!=PEEK(&H41)*256+PEEK(&H40):DEF SEG=ZS!
  120. 5210  IF PEEK(ZO!+27)=44 AND PEEK(ZO!+28)=40 AND PEEK(ZO!+29)=45 AND PEEK(ZO!+30)=41 THEN POKE ZO!+10,BORDER:POKE ZO!+11,BG:POKE ZO!+12,FG:POKE ZO!+13,FGHI:IF REVVID=1 THEN POKE ZO!+14,FGINV*16 ELSE POKE ZO!+14,FGINV ELSE RETURN
  121. 5220  I=VARPTR(SUB2$)
  122. 5230  DEF SEG:OFS!=PEEK(I+1)+256*PEEK(I+2)
  123. 5240  IF OFS!>32768 THEN J=OFS!-65536 ELSE J=OFS!
  124. 5250  IF I<>VARPTR(SUB2$) THEN 5220
  125. 5260  LOCATE 24,70,0:CALL J(SGRSTR$)
  126. 5270  RETURN
  127. 9000  REM Display initial menu
  128. 9010  A$="DOSCOLOR MAIN MENU":LOCATE 7,FNCENT(A$):PRINT A$
  129. 9020  LOCATE 9,T1:PRINT "1. Select border color"
  130. 9030  LOCATE 11,T1:PRINT "2. Select background color"
  131. 9040  LOCATE 13,T1:PRINT "3. Select foreground colors"
  132. 9050  LOCATE 15,T1:PRINT "4. Exit program"
  133. 9060  LOCATE 19,T1,1,0,7:PRINT "Type the number of your choice: ";
  134. 9070  RETURN
  135. 10000  REM Border routine
  136. 10010  CLS
  137. 10020  A$=INKEY$
  138. 10030  FOR I=1 TO 2:LOCATE (I-1)*23+1,1:PRINT CHR$(202-I);:FOR J=2 TO SWID-1:PRINT CHR$(205);:NEXT J:NEXT I:LOCATE 1,SWID:PRINT CHR$(187);:DEF SEG=&HB800:POKE (24*SWID-1)*2,188:DEF SEG
  139. 10040  FOR I=2 TO 23:LOCATE I,1:PRINT CHR$(186);:LOCATE I,SWID:PRINT CHR$(186);:NEXT I
  140. 10050  RETURN
  141. 11000  REM Keyboard input routine
  142. 11010  A$=""
  143. 11020  WHILE A$=""
  144. 11030  A$=INKEY$
  145. 11040  WEND
  146. 11050  I=LEN(A$):ON I GOTO 11070,11090
  147. 11060  GOTO 11010
  148. 11070  J=ASC(MID$(A$,1,1))
  149. 11080  RETURN
  150. 11090  J=ASC(MID$(A$,2,1))
  151. 11100  RETURN
  152. 12000  DEF SEG=&HFACE:K=1:I=13
  153. 12010  T$=STRING$(13,32):J=1
  154. 12020  TMP=PEEK(I):IF TMP<>0 THEN MID$(T$,J,1)=CHR$(TMP):J=J+1:I=I+1:GOTO 12020
  155. 12030  KEY K,LEFT$(T$,J-1):IF K<10 THEN K=K+1:I=I+1:GOTO 12010 ELSE KEY ON:DEF SEG:LOCATE ,,1,7,7:RETURN
  156. 13000  REM Display function keys
  157. 13010  IF SWID=80 THEN T3=10:T4=26:T5=47:T6=67 ELSE T3=2:T4=10:T5=23:T6=35
  158. 13020  COLOR FG,BG,BORDER:LOCATE 25,T3:PRINT "1";:LOCATE ,T4:PRINT "2";:LOCATE ,T5:PRINT "3";:LOCATE ,T6:PRINT "4";
  159. 13030  IF REVVID=1 THEN FGINVCF=BG:FGINVCB=FGINV ELSE FGINVCF=FGINV:FGINVCB=BG
  160. 13040  COLOR FGINVCF,FGINVCB,BORDER:LOCATE 25,T3+1:PRINT "BORDER";:LOCATE ,T4+1:PRINT "BACKGROUND";:LOCATE ,T5+1:PRINT "FOREGROUND";:LOCATE ,T6+1:PRINT "EXIT";:COLOR FG,BG,BORDER
  161. 13050  RETURN
  162. 14000  REM Display title
  163. 14010  IF SWID=80 THEN T3=35 ELSE T3=15
  164. 14020  FOR I=1 TO 2:LOCATE (I-1)*2+3,T3:PRINT CHR$(202-I);:FOR J=T3+1 TO T3+10:PRINT CHR$(205);:NEXT J:PRINT CHR$(186+I);:NEXT I
  165. 14030  FOR I=4 TO 4:LOCATE I,T3:PRINT CHR$(186);:LOCATE I,T3+11:PRINT CHR$(186);:NEXT I
  166. 14040  LOCATE 4,T3+2:PRINT "DOSCOLOR";
  167. 14050  RETURN
  168. 15000  REM Sound alarm and return
  169. 15010  SOUND 240,6:RETURN
  170. 16000  REM Display border selection screen
  171. 16010  A$="Border selection menu":LOCATE 10,FNCENT(A$):PRINT A$
  172. 16020  LOCATE 12,T1:PRINT "1. Next border color"
  173. 16030  LOCATE 14,T1:PRINT "2. Previous border color"
  174. 16040  LOCATE 16,T1:PRINT "3. Return to main menu"
  175. 16050  LOCATE 19,T1,1,0,7:PRINT "Type the number of your choice: ";
  176. 16060  RETURN
  177. 17000  REM Display background selection screen
  178. 17010  A$="Background selection menu":LOCATE 10,FNCENT(A$):PRINT A$
  179. 17020  LOCATE 12,T1:PRINT "1. Next background color"
  180. 17030  LOCATE 14,T1:PRINT "2. Previous background color"
  181. 17040  LOCATE 16,T1:PRINT "3. Return to main menu"
  182. 17050  LOCATE 19,T1,1,0,7:PRINT "Type the number of your choice: ";
  183. 17060  RETURN
  184. 18000  REM Display foreground selection screen
  185. 18010  IF NL<>0 THEN NL=1
  186. 18020  A$="Foreground selection menu":LOCATE 9,FNCENT(A$):PRINT A$
  187. 18030  IF REVVID=1 THEN A$="OFF" ELSE A$="ON"
  188. 18040  IF REVVID=1 THEN FGINVCF=BG:FGINVCB=FGINV ELSE FGINVCF=FGINV:FGINVCB=BG
  189. 18050  LOCATE 11,T2:PRINT "1. Next foreground color"
  190. 18060  LOCATE 12,T2:PRINT "2. Previous foreground color"
  191. 18070  LOCATE 13,T2:PRINT "3. Next foreground";BLINE$;IND$;" '";:COLOR FGHI:PRINT "High-intensity";:COLOR FG:PRINT "' color"
  192. 18080  LOCATE 14+NL,T2:PRINT "4. Previous foreground";BLINE$;IND$;" '";:COLOR FGHI:PRINT "High-intensity";:COLOR FG:PRINT "' color":IF NL=1 THEN NL=2
  193. 18090  LOCATE 15+NL,T2:PRINT "5. Turn '";:COLOR FGINVCF,FGINVCB:PRINT "Inverse";:COLOR FG,BG:PRINT "' ";A$
  194. 18100  LOCATE 16+NL,T2:PRINT "6. Next foreground '";:COLOR FGINVCF,FGINVCB:PRINT "Inverse";:COLOR FG,BG:PRINT "' color"
  195. 18110  LOCATE 17+NL,T2:PRINT "7. Previous foreground '";:COLOR FGINVCF,FGINVCB:PRINT "Inverse";:COLOR FG,BG:PRINT "' color"
  196. 18120  LOCATE 18+NL,T2:PRINT "8. Return to main menu"
  197. 18130  LOCATE 20+NL,T2,1,0,7:PRINT "Type the number of your choice: ";
  198. 18140  RETURN
  199. 20000  REM Error trap
  200. 20010  RESUME NEXT
  201. 21000  REM Move page in display buffer
  202. 21010  I=VARPTR(SUB$)
  203. 21020  DEF SEG:OFS!=PEEK(I+1)+256*PEEK(I+2)
  204. 21030  IF OFS!>32768 THEN J=OFS!-65536 ELSE J=OFS!
  205. 21040  IF I<>VARPTR(SUB$) THEN 21010
  206. 21050  CALL J(PAGFROM,PAGTO,BG,FG)
  207. 21060  RETURN
  208. 22000  REM Output File Error trap
  209. 22010  IF D$="" THEN D$="A:" ELSE IF D$="A:" THEN D$="B:" ELSE IF D$="B:" THEN D$="C:" ELSE IF D$="C:" THEN D$="D:" ELSE 22030
  210. 22020  RESUME 5030
  211. 22030  LOCATE 21,5:COLOR 4:PRINT "Cannot find DOSCOLOR.COM";BLINE$;"Please check the instructions";:SOUND 240,30
  212. 22040  FOR I=1 TO 5000:NEXT I:CLOSE:CLS:SYSTEM
  213. 23000  REM Input File Error trap
  214. 23010  IF D$="" THEN D$="A:" ELSE IF D$="A:" THEN D$="B:" ELSE IF D$="B:" THEN D$="C:" ELSE IF D$="C:" THEN D$="D:" ELSE GOTO 23030
  215. 23020  RESUME 570
  216. 23030  RESUME 690
  217.